perm filename CMDEMO.MF[TYP,TEX] blob sn#723016 filedate 1983-08-04 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00016 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	mode = proof
C00004 00003	"Computer Modern Roman 10 point"
C00006 00004	% From file CMBASE.MF[MF,SYS]
C00053 00005	% From file AMR10.MF[MF,SYS]
C00054 00006	% From file ROMAN[MF,SYS]
C00058 00007	% From file ROMANU[MF,SYS]
C00060 00008	% From file ROMANU[MF,SYS]
C00064 00009	% From file ROMANU[MF,SYS]
C00068 00010	% From file ROMANU[MF,SYS]
C00072 00011
C00074 00012
C00077 00013
C00080 00014
C00084 00015
C00089 00016	% From file AMR10.MF[MF,SYS]
C00090 ENDMK
C⊗;
mode = proof;

%-------------------------------------------------------------------
% Rescale the image so it will fit in a 12 pica square.

oldsize = 8;		% The character was originally this many picas tall.
newsize = 12.1;		% So it will be this many picas tall, we must
blowup  = newsize/oldsize;	% rescale it by this factor.

mag = blowup;

"Computer Modern Roman 10 point";
fontidentifier "CMR"; ptsize=10;
pww=7/36; % small hairline width
puw=11/36; % uppercase hairline width
pscorr=1/36; % some stems to be this much thinner
pbow=1/36; % baseline serifs to be bowed by this much
phcorr=1/36; % some hairlines to be this much thicker
pdot=38/36; % dots
pws=11/36; % thickness of serifs and arms
pwu=11/36; % thickness of uppercase bars (A and H)
pwb=11/36; % thickness of uppercase bowl bars
uc=0; % correction to unit measurements on certain characters
usc=-.25;	% uppercase serif correction
sqdot=0; % dots to be round
theta=1/6; % affects super-ness inside bowls
aspw=8/36; % hairline height
prt=.4;	% rule thickness for math symbols
mathspread=0;	% proportion of spreading for symbols like =
psmid=27.5/36;	% thickness of stroke in middle of "s"

ph=250/36; px=155/36; pe=87/36; pd=70/36;
pb=20/36; po=8/36; ps=20/36; pas=70/36; pa=.5(ph-pd);
pw=9/36; pwi=25/36; pwii=30/36; pwiii=33/36;
pwiv=32/36; pwv=37/36; pdel=0; fudge=1.0;
pu=20/36; lcs=1.4; ucs=1.85; sc=0; ls=0;
slant=0; sqrttwo=sqrt 2; fixwidth=0; crisp=1;
phh=ph-pssd; phhh=ph-18/36; pssd=.5po; pdd=pd; varg=0; lowast=0; ligs=1.
% From file CMBASE.MF[MF,SYS]

eps=.000314159;	% a very small random positive number
circlemode;
proof=0; lowres=1; crs=2; dover=3; canon=5; smoke=6;	% symbolic names of modes
designsize ptsize; % ignore error messages you get with old MF!
if mode<0: mmode=-mode; new mode; mode=mmode;	% negative modes assume \\{mag} is set
else: new mag; mag=1;
fi;
stephalf=sqrt(1.2); stepi=1.2; stepii=1.44; stepiii=1.728;
stepiv=2.0736; stepv=2.48832;
magnification mag;
if mode=proof: proofmode; drawdisplay; titletrace;
	pixels=36*mag; blacker=0; overcorr=1;	% for initial design of characters
else:	if mode=lowres: fntmode; tfxmode; no modtrace;
		pixels=(200/72.27)mag; blacker=.65; overcorr=.4;	% XGP, etc.
	else: if mode=crs: crsmode; tfxmode; titletrace; no modtrace;
			pixels=(16000/(3*72.27))mag; blacker=4; overcorr=1;	% Alphatype
		else: if mode=dover: ocmode; tfmmode; dotwdmode; no modtrace;
				overcorr=.6;
				pixels=(384/72.27)mag; blacker=1.2;  % Xerox Dover
			else: if mode=canon: rstmode; tfxmode; no modtrace;
					pixels=(240/72.27)mag;	  % Canon LBP10
					blacker=.2; overcorr=.4;
			else: if mode=smoke: proofmode; titletrace; no points;
					no modtrace;
					pixels=72;
					blacker=0; overcorr=1;
				else: input mode;
				fi; fi;
			fi;
		fi;
	fi;
fi;
%fontfacebyte 254-2*ptsize; % that was used for old cm fonts
fontfacebyte 154-2*ptsize; % new convention for am fonts!
if ptsize>77: fontfacebyte 252;
fi;
hresolution pixels; vresolution pixels.

subroutine fontbegin:	% Initialize before making a font:
no eqtrace;	% Turn off tracing within this subroutine
new typesize;	% the vertical size of the font
new cf;		% conversion factor, approximately equal to \\{pixels}
new h,hh,hhh,d,dd,m,e,o,oo,b,s,ssd,ssdoo,as,a;	% raster-oriented vertical dimensions
new del; del=round pixels.pdel;	% raster-oriented displacement at corners
new w0,w1,w2,w3,w4,w5,w6,w10,w11;	% raster-oriented pen sizes
new w15,w16,w17,w18,w19,w20,w21,w22,w25,w26,w30;	% ditto, second-generation
new scorr,hcorr,bow; % more second-generation stuff
new deltaw,bold;	% unrounded raster-oriented pen size values
new armic,lcic;	% italic corrections commonly used
w0=round(pixels.pw+blacker);	% hairline width
w1=round(pixels.pwi+blacker);	% stem width
w2=round(pixels.pwii+blacker);	% curve width
w3=round(pixels.pwiii+blacker);	% basis for bulbs and terminals
w4=round(pixels.pwiv+blacker);	% uppercase stem width
w5=round(pixels.pwv+blacker);	% uppercase curve width
w6=round(pixels.aspw+blacker);	% hairline height
new w7; w7=round(.85pixels.pwi+blacker); % patch for stem height
new w8; w8=round(.85pixels.pwii+blacker); % patch for curve height
new w9; w9=round(.85pixels.pwiv+blacker); % patch! the old w9 is gone
%prt=.25[pw,pwii];	% rule thickness in points, it's now a parameter
w10=-round(-pixels.prt-.5);	% raster-oriented rule thickness
% the above corresponds to TEX82 rule about rules
if pw>.5pwi: w11=round(pixels(.6[aspw,pwi])+blacker);
else:w11=round(pixels(.3[pw,pwi])+blacker);	% between hairline and stem
fi;
deltaw=pixels.(pwii-pwi);	% one step of boldening
bold=pwii.pixels+blacker; % background for boldening
w15=round(pixels.psmid+blacker); % height of stroke in middle of "s"
w16=round(pixels.puw+blacker);	% width of hairlines in upper case
w17=round(pixels.pwb+blacker);	% thickness of uppercase bowl bars
w18=round(pixels.pwu+blacker);	% thickness of bars in upper case
w19=round(pixels.pws+blacker);	% serif and arm thickness
w20=round(pixels.pww+blacker);	% small hairline width
scorr=pixels.pscorr;	% some stems to be this much thinner
w21=w1-round(scorr); % light stem width
bow=round(pixels.pbow);	% amount of bowing to erase from serifs
hcorr=pixels.phcorr;	% some hairlines to be this much thicker or thinner
if pws-2phcorr+eps<aspw: error;	% restriction on parameter sizes
fi;
if round(w19-2hcorr)<w6: new hcorr; w19-2hcorr=w6-.49;
fi;	% the programs can assume that round(w19-2hcorr)≥w6
w22=round(w6+hcorr); % heavy hairline height % "round" added July 7 '83
w30=round(pixels.pdot+blacker);	% basis for dots
if aspw>.5fudge.fudge.pwi: w26=round(.375fudge.fudge.w1+.5);
	w25=round(.25fudge.fudge.w1+.5);
else: 	w26=round(.75w6); w25=round(.5w6);
fi;	% smaller radii for certain corners

% The following corrections are for low resolution:
if w3/w1>5/4(pwiii/pwi): new w2,w3; w2=w3=w1;
fi;
if w2/w1>1.1(pwii/pwi): new w2; w2=w1;
fi;
if w5/w4>1.1(pwv/pwiv): new w5; w5=w4;
fi;
if w0<3: new crisp; crisp=0;
fi;
hpenht w6;  vpenwd w0; lpenht w6; rpenht w6;
typesize=ph+pd+2pb; cf.typesize=pixels.typesize-1;
h=round cf.ph;  d=round cf.pd; 
hh=round cf.phh; hhh=round cf.phhh; dd=round cf.pdd;
m=round cf.px; a=.5 round 2cf.pa;
o=round cf.po.overcorr; oo=round .5cf.po.overcorr;
s=cf.ps; ssd=round cf.pssd; as=cf.pas+eps;
if ssd>oo: ssdoo=oo;
else: ssdoo=ssd;
fi;
b=-round(.5(h+d-typesize.pixels));
e=cf.pe;
maxht h+b+4;
trxy slant;
if ucs≠0: armic=phh.slant-pu;
else: armic=phh.slant-.5pu;
fi;	% armic and lcic should really be calculated in romanu and romanl...
if pwii>1.5pu: lcic=-.25pu;
else: lcic=.5pwii-pu;
fi.

subroutine charbegin(var charno)	% seven-bit character code
		(var charuw)		% character width in units
	(var lftcorr, var rtcorr)	% sidebar corrections in units
(var charh, var chard, var chari):	% \&{charht}, \&{chardp}, \&{charic} values in points
no eqtrace; no calltrace; no drawdisplay;	% no tracing in this subroutine
new uw,moduw;	% the correct character width in units
new r;	% raster-oriented character width
new u;	% raster-oriented design unit
new tu;	% unmodified raster-oriented unit
new italcorr;	% italic correction
new lcorr,rcorr;	% left and right corrections
if chari≥0: italcorr=chari; else: italcorr=0;
fi;
if danger≠0: % rounding of character width is necessary
	lcorr=danger.round((lftcorr-ls)/danger);
	rcorr=danger.round((rtcorr-ls)/danger);
else: lcorr=lftcorr-ls; rcorr=rtcorr-ls;
fi;
tu=pu.pixels; uw=charuw-(lcorr+rcorr);
if fixwidth=0: moduw=uw;
else: moduw=9; new italcorr; italcorr=(ph+pb).slant;
fi;
r=charuw.(u+eps)=round((moduw.tu-2).charuw/uw);
% u+eps is better than u, because otherwise "round c.u" and "round(r-c.u)"
% will both be biased upwards when c-u is exactly integer+.5
% and similar phenomena would occur in other calculations re u (e.g. serifs)
charcode charno; charic italcorr;
if charh>0: charht charh;
else: charht 0;
fi;
if chard>0: chardp chard;
else: chardp 0;
fi;
charwd moduw.pu; chardw moduw.tu;
%incx round(-lcorr.tu);
incx round(-lftcorr.tu)+round(ls.tu);	% makes letterspacing more consistent
% because e.g. ital font sometimes has ls, sometimes ls-1 as the sidebar correction
if mode=smoke: call corners(round lcorr.u,(round lcorr.u)+u.uw); fi.

subroutine newic(var corr):	% change the italic correction
new italcorr;
if corr>0: italcorr=fixwidth[corr,0];
else: italcorr=0;
fi;
charic italcorr.

subroutine box(var offset):	% Draw guidelines and box around a character:
no drawtrace; no proofmode;
new topp,bott,left,right,pos;
topp=h+b; bott=-d-b;
left=offset; right=offset+u.uw;
x1=x3=x5=x7=x9=x11=x13=x15=x17=left;
x2=x4=x6=x8=x10=x12=x14=x16=x18=right;
y1=y2=0; cpen;  1 draw1..2;	% baseline
y3=y4=e; draw3..4;	% e-height
y5=y6=m; draw5..6;	% mean line (x-height)
y7=y8=h; draw7..8;	% h-height
y9=y10=topp; draw9..10;	% top of character
y11=y12=-d; draw11..12;	% descender line
y13=y14=bott; draw13..14;	% bottom of character
trxy 0;	% temporarily turn off the slant
y15=y16=topp;  y17=y18=bott;
draw15..17; draw16..18;	% left and right edges
if italcorr>0: x19=x20=right+italcorr.pixels;
	y19=topp;  y20=0; draw 19..20;	% show italic correction
fi;
trxy slant;	% restore slanted transformation
pos=0; call unitlines.	% draw the unit guidelines

subroutine unitlines:	% Recursive subroutine to draw guidelines:
x1=x2=pos;y1=topp;y2=bott;cpen;
if pos≥left: 1 draw1..2;
fi;
new pos; pos=x1+u;
if pos≤right: call unitlines;
fi.

subroutine corners(var lfttt, var rttt):
no drawdisplay; no proofmode; no drawtrace; no plottrace;
x1=x2=x3=x4=x5-10=x6-10=lfttt;
x7+10=x8+10=x9=x10=x11=x12=rttt;
y1=y2+10=y5=y7=y9=y10+10=hh;
y3-10=y4=y6=y8=y11-10=y12=0;
cpen; 1 draw 2..1..1..5; draw 7..9..9..10; draw 3..4..4..6; draw 8..12..12..11.

subroutine arithbegin(var c): % character code of arithmetic operator
% The common operators (plus, minus, times, plus-or-minus, ... )
% are given consistent heights and depths by this routine.
if fixwidth=0: call charbegin(c,14,0,0,pa+6pu,6pu-pa,pa.slant-.5pu);
else: call charbegin(c,9,0,0,3.5pu+pa,3.5pu-pa,0);
fi.
% The following subroutines are used to draw common features of characters.

subroutine dot(index i)		% center of dot
		(index j):	% index of $w$-variable for dot size
cpen;
if sqdot=0: wj draw i;	% round dot
else: top6y1=top j yi; bot6y2=bot j yi;
	x1=x2=xi; hpen; wj draw 1..2;	% squarish dot
fi.

subroutine comma(index i)		% center of dot in comma
		(index j)	% index of $w$-variable for dot size
		(var theta):	% ``openness''
cpen;
if sqdot=0: wj draw i;	% round dot
	top6y1=top j yi; bot6y3=bot j yi-dd; y2=1/3[y1,y3];
	x1=xi; rt6x2=round(rt j xi +theta.pixels.pu); x3=good6(xi-.5pixels.pu);
	w6 draw 1{1,0}..2{0,-1}..3{4(x3-x2),y3-y2};
else: new w95; w95=round .5w6;
	call dot(i,j);	% squarish dot
	bot95y14=bot j yi; y13=y14; lft95x13=round(lft j xi+.3wj+.501);
	rt95x14=rt j xi;
	y12=yi; x12=x14;
	bot95y15=bot j yi-dd; y15=y16;
	lft95x15=lft j xi; x15=x16-((round.5wj)-w95);
	w95 ddraw 12..13, 12..14; ddraw 13..15, 14..16;	% taper
fi.

subroutine ucomma(index i)		% center of dot of inverted apostrophe
		(index j)	% index of $w$-variable for dot size
		(var theta):	% ``openness''
% there is rotational symmetry with respect to the previous subroutine
cpen;
if sqdot=0: wj draw i;	% round dot
	bot6y1=bot j yi; top6y3=top j yi+dd; y2=1/3[y1,y3];
	x1=xi; lft6x2=round(lft j xi-theta.pixels.pu); x3=good6(xi+.5pixels.pu);
	w6 draw 1{-1,0}..2{0,1}..3{4(x3-x2),y3-y2};	% tail
else: new w95; w95=round .5w6;
	call dot(i,j);	% squarish dot
	top95y14=top j yi; y13=y14; rt95x13=round(rt j xi-.3wj-.501);
	lft95x14=lft j xi; y12=yi; x12=x14;
	top95y15=top j yi+dd; y15=y16;
	rt95x15=rt j xi; x15=x16+((round.5wj)-w95);
	w95 ddraw 12..13, 12..14; ddraw 13..15, 14..16;	% taper
fi.

subroutine serif(index i)	% point where serif appears
		(index k)	% $w$-variable for stem line
		(index j)	% another point on the stem line
		(var theta)	% fill-in ratio
		(var sl):	% serif length
cpen;
if yi<yj: y2=yi+s+(w19-w20); bot20y11=bot6yi; y1=y11+(w19-w20); y5=y4+(w19-w6);
else: y2=yi-s-(w19-w20); top20y11=top6yi; y1=y11-(w19-w20); y5=y4-(w19-w6);
fi;
if sl<0: lft20x1=lft k xi+sl.u;
	lft20x2=lft k (y2-yi)/(yj-yi)[xi,xj];
else: rt20x1=rt k xi+sl.u;
	rt20x2=rt k (y2-yi)/(yj-yi)[xi,xj];
fi;
no proofmode; x1=x11; x12=xi; y12=y11; y4=yi;
x3=theta[x1-sl.u,1/2[x1,x2]]; 
y3=theta[y1,1/2[y1,y2]];
minvr 0; minvs 0;
w20 ddraw 1{xi-x1,0}..3{x2-x1,y2-y1}..2{xj-xi,yj-yi}, 11..12..2; % serif stroke
minvr 0.5; minvs 0.5;
if crisp≠0: if round(w20/2)=w20/2: x4=x1-.5; 
	else: x4=x1;
	fi;
	x5=x4;
	if sl<0: lpen; .5w20-1 draw 4..5;
	else: rpen; .5w20-.5 draw 4..5;
	fi;
fi.

subroutine dserif(index i)	% point where dark serif appears
		(index k)	% $w$-variable for stem line
		(index j)	% another point on the stem line
		(var theta)	% fill-in ratio
		(var sl):	% serif length
x1=s; new s; s=1.5x1;
call serif(i,k,j,theta,sl);
new s; s=x1.

subroutine sserif(index i)	% point where sheared serif appears
		(index k)	% $w$-variable for stem line
		(index j)	% another point on the stem line
		(var theta)	% fill-in ratio
		(var sl):	% serif length
hpen; lft0x1=lft k xi + sl.u; x3=xi; rt0x2=rt k xi;
y1=y3=yi-ssd; y2=yi;
lpen#; wk draw 2..1;	% erase excess
if crisp=0: hpen; w0 ddraw 2..1,3..1;	% diagonal down to the spur
else: lpen; (w0-1-eps)/2 ddraw 2..1,3..1;	% diagonal down to the spur
	rpen; (w0-1-eps)/2 draw 2; cpen; w6 draw 2;
fi;
call serif(3,k,j,theta,sl).	% spur

subroutine rsserif(index i)	% point where reverse sheared serif appears
		(index k)	% $w$-variable for stem line
		(index j)	% another point on the stem line
		(var theta)	% fill-in ratio
		(var sl):	% serif length
hpen; rt0x1=rt k xi + sl.u; x3=xi; lft0x2=lft k xi;
y1=y3=yi+ssd; y2=yi;
rpen#; wk draw 2..1;	% erase excess
if crisp=0: hpen; w0 ddraw 2..1,3..1;	% diagonal down to the spur
else: rpen; (w0-1-eps)/2 ddraw 2..1,3..1;	% diagonal down to the spur
	lpen; (w0-1+eps)/2 draw 2; cpen; w6 draw 2;
fi;
call serif(3,k,j,theta,sl).	% spur

subroutine notch(index i)	% top middle
		(index j)	% top edge
		(index d)	% diameter of pen
		(index k)	% bottom middle
		(index l):	% untouchable point at base of notch
%new rho;
%if xi<xk: x9=rt d xj;
%else: x9=lft d xj;
%fi;
%y9=yj; x7=xl; (yi-yk)(x9-x7)=(y9-y7)(xi-xk); y8=y7; x7-x8=x9-xj;
%rho=sqrt((y7-yl)(y7-yl)/((xi-xk)(xi-xk)+(yi-yk)(yi-yk)));
%x1-x8=rho(xi-xk); y1-y8=rho(yi-yk);
%if (yi-yk)(yj-y1)≤0: new x1,y1; x1=xj; y1=yj;
%fi;
%cpen; y1=y2; x1-xj=x2-xi;
cpen; y3=yl; x4=x5=xl; y4=y6; y5=yk;
if yi>yk: top d y4=yl-1;
else:	bot d y4=yl+1;
fi;
if xi>xk: lft d x3=xl+1;
	if x5>xk: new x5; x5=xk;
	fi;
else:	rt d x3=xl-1;
	if x5<xk: new x5; x5=xk;
	fi;
fi;
new aa; y6=aa[yi,yk]; x6=aa[xi,xk];
minvr 0.0; minvs 0.0;
%wd ddraw i..2..k, j..1{xk-xi,yk-yi}..3{0,yk-yi};	% half-diagonal
wd ddraw i..k, j{xk-xi,yk-yi}..3{0,yk-yi};	% half-diagonal
minvr 0.5; minvs 0.5;
ddraw 6..4, k..5.	% fill in under the notch

subroutine diag(index i)	% sharp corner
		(index j)	% corner with edge at left or right
		(index k)	% corner with edge at top or bottom
		(index l)	% corner opposite $i$
		(index di)	% smaller diameter (at $i$)
		(index d):	% larger diameter (at $j$, $k$, $l$)
cpen; y1=yj; x2=xk;
if xi<xk: lft di x1=lft d xj;
else: rt di x1=rt d xj;
fi;
if yi>yj: top di y2=top d yk;
else: bot di y2=bot d yk;
fi;
wdi ddraw 1..i, 1..2;	% the $i$ half of the parallelogram
wd ddraw j..k, l..k.	% the $l$ half of the parallelogram

subroutine easydiag(index i) 	% top point
		(index k)	% width at top
		(index j)	% bottom point
		(index l)	% width at bottom
		(index d):	% height at top and bottom
% simpler than diag, since a cpen of diameter $d$ can be used
cpen; lft k xi=lft d x1; rt k xi=rt d x2; y1=y2=yi;
lft l xj=lft d x3; rt l xj=rt d x4; y3=y4=yj;
wd ddraw 1..3, 2..4.	% diagonal

%subroutine darc(index i)	% starting point
%		(index j)	% opposite corner point
%		(var maxwidth):	% the pen grows from $w↓0$ to this size
%x5=xi;  x2=x4=1/sqrttwo [xi,xj];  x3=xj;
%y5=yj;  y3=1/2[yi,yj];
%y2=1/sqrttwo [y3,yi];  y4=1/sqrttwo [y3,yj];
%hpen;  draw |w0|i{x3-xi,0}..|2/3[w0,maxwidth]|2{x3-xi,y3-yi}..
%	|maxwidth#|3{0,y3-yi}..
%	|2/3[w0,maxwidth]|4{x5-x3,y5-y3}..|w0|5{x5-x3,0}.

subroutine arc(var theta)	% ratio to bring out the inside curve
		(index i)	% horizontal endpoint
		(index k)	% thickness at horizontal endpoint
		(var delta)	% offset for interior horizontal endpoint
		(index j)	% vertical endpoint
		(index l):	% thickness at vertical endpoint
cpen;
new w84;
if wk<w20: w84=wk;
else: w84=w20;
fi;
if wl<w84: new w84; w84=wl;
fi;
if yi>yj: top k yi=top84y1; bot k yi=bot84y2;
else:	bot k yi=bot84y1; top k yi=top84y2;
fi;
if xi<xj: lft l xj=lft84x6; rt l xj=rt84x5;
else:	rt l xj=rt84x6; lft l xj=lft84x5;
fi;
x1=xi; x2=xi+delta; y5=y6=yj;
x3=1/sqrttwo[x1,x5]; x4=theta[1/sqrttwo[x2,x6],x3];
y3=1/sqrttwo[y5,y1]; y4=theta[1/sqrttwo[y6,y2],y3];
w84 ddraw 1{x5-x1,0}..3{x5-x1,y5-y1}..5{0,y5-y1},
	2{x6-x2,0}..4{x6-x2,y6-y2}..6{0,y6-y2}. % quarter-bowl

% DESTROY THIS ONE WHEN YOU CAN
%subroutine oldarc(index i)		% horizontal endpoint
%		(index j)	% vertical endpoint
%		(var maxwidth):	% the pen grows from $w↓0$ to this size
%x1=1/sqrttwo[xi,xj]; y1=1/sqrttwo[yj,yi];
%hpen; draw |w0|i{xj-xi,0}..|2/3[w0,maxwidth]|1{xj-xi,yj-yi}..
%	|maxwidth|j{0,yj-yi}.

subroutine arm(index i)		% starting point
		(index j)	% horizontal endpoint
		(index k)	% serif endpoint
		(var delt)	% thickness control
		(var thicker):	% additional overall thickness
% the last parameter should be negative to make upper arms thicker
% $y↓k$ should be (at least slightly) less than $y↓j$ in upper arms
hpen;
x4=xi; y4=good6(yi+thicker); x5=xj; y5=good6(yj+thicker);
y7=good6yk;
if ucs≠0:
	if pw>.5pwi: x1=x6=xk; y1=yj; y6=y5;
		w0 ddraw 4..6, i..1; draw 1..k;
	else: minvr 0; minvs 0;
		x1=xj-delt; y1=.2[y5,y7];
		x2=x7=xk; y2=2[y5,y7];
		x3=x6=.5[xi,x1]; y3=yi; y6=y4;
		w0 ddraw i..3..j..7, 4..6{x6-x4,0}..1..7(..2);
		minvr 0.5; minvs 0.5;
	fi;
else: new w73; w73=round .75w6; cpen; y11=y12; x11=x14=xi; x12=x13;
	if yk<yj: top73y11=top6yi; bot73y14=bot6y4; bot73y13=bot6y7;
	else: bot73y11=bot6yi; top73y14=top6y4; top73y13=top6y7;
	fi;
	if xi<xj: rt73x12=rt0xk;
	else: lft73x12=lft0xk;
	fi;
	w73 ddraw 11..12, 14..13;
fi.

subroutine scomp(index i)	% starting point
		(index p)	% turning point ($y↓p$ to be defined)
		(index j)	% transition point (to be defined)
		(index k)	% ending point
		(var slope):	% ending slope
% This subroutine computes $y↓p$, $x↓j$, $y↓j$ so that $y↓k-y↓j=\\{slope}.(x↓k-x↓j)$
% and so that the following curve is consistent with an ellipse:
% $i\{x↓p-x↓i,0\}\to p\{0,y↓p-y↓i\}\to j\{x↓k-x↓p,\\{slope}.(x↓k-x↓p)\}$.
yk-yj=slope(xk-xj);
new aa,bb; aa=slope(xp-xi); bb=yk-yi-slope(xk-xi);
xj-xi=-2aa.bb(xp-xi)/(aa.aa+bb.bb);
yp-yi=.5(bb.bb-aa.aa)/bb.

subroutine sdraw(index i)	% starting point
		(index p)	% upper turning point ($y↓p$ to be defined)
		(index k)	% middle point
		(index q)	% lower turning point ($y↓q$ to be defined)
		(index j)	% ending point
		(var ppenwd)	% width control at $p$
		(var qpenwd)	% width control at $q$
		(var penht)	% height control at $k$
		(var tth)	% thickness at the top
		(var bth)	% thickness at the bottom
		(var slope):	% slope at point $k$
new w47,w48,w49,w50,w51; w47=round ppenwd; w48=round qpenwd; w49=penht;
w50=tth; w51=bth;
cpen; top20y5=top49yk; bot20y6=bot49yk; x5=x6=xk;
if xp<xi: rt47xp=rt20x1; lft47xp=lft20x2; rt48xq=rt20x9; lft48xq=lft20x10;  
else: lft47xp=lft20x1; rt47xp=rt20x2; lft48xq=lft20x9; rt48xq=rt20x10;
fi;
y2=yp; y9=yq;
x11=x12=xi; top20y12=top50yi; bot20y11=bot50yi;
call scomp(11,1,3,5,slope);	% compute $y↓1$ and point 3
call scomp(12,2,4,6,slope);	% compute $y↓2$ and point 4
if (yi-y1+eps)/(xi-x1+eps)/(xi-x1+eps)<(yi-y2+eps)/(xi-x2+eps)/(xi-x2+eps):
%	error; % OK to go on; but I should fix this code later!
	new x1,y1,aa,x3,y3;	% correction to keep ellipses from crossing
	2(yi-y2+eps)/(xi-x2+eps)/(xi-x2+eps)=(yi-y5+eps)aa-slope.slope/(yi-y5+eps);
	if xp<xi: xi-x1=1/sqrt aa;
	else: xi-x1=-1/sqrt aa;
	fi;
	call scomp(i,1,3,5,slope);	% recompute $y↓1$ and point 3
fi;
x13=x14=xj; top20y14=top51yj; bot20y13=bot51yj;
call scomp(13,9,7,5,slope);	% compute $y↓9$ and point 7
call scomp(14,10,8,6,slope);	% compute $y↓{10}$ and point 8
if (yj-y10+eps)/(xj-x10+eps)/(xj-x10+eps)>(yj-y9+eps)/(xj-x9+eps)/(xj-x9+eps):
%	error; % OK to go on; but I should fix this code later!
	new x10,y10,aa,x8,y8;	% correction to keep ellipses from crossing
	2(yj-y9+eps)/(xj-x9+eps)/(xj-x9+eps)=(yj-y6+eps)aa-slope.slope/(yj-y6+eps);
	if xq<xj: xj-x10=1/sqrt aa;
	else: xj-x10=-1/sqrt aa;
	fi;
	call scomp(j,10,8,6,slope);	% recompute $y↓{10}$ and point 8
fi;
w20  ddraw 11{x1-x11,0}..1{0,y1-y11}..3{xq-xp,slope(xq-xp)}..
		7{xq-xp,slope(xq-xp)}..
		9{0,y13-y9}..13{x13-x9,0},
	12{x2-x12,0}..2{0,y2-y12}..4{xq-xp,slope(xq-xp)}..
		8{xq-xp,slope(xq-xp)}..
		10{0,y14-y10}..14{x14-x10,0}.	% the s-curve

subroutine zcomp(index i)	% starting point
		(index p)	% turning point ($x↓p$ to be defined)
		(index j)	% transition point (to be defined)
		(index k)	% ending point
		(var slope):	% reciprocal of ending slope
% This subroutine is dual to \\{scomp}.
% It computes $x↓p$, $x↓j$, $y↓j$ so that $x↓k-x↓j=\\{slope}\cdot(y↓k-y↓j)$
% and so that the following curve is consistent with an ellipse:
% $i\{0,y↓p-y↓i\}\to p\{x↓p-x↓i,0\}\to j\{\\{slope}.(y↓k-y↓p),y↓k-y↓p\}$.
xk-xj=slope(yk-yj);
new aa,bb; aa=slope(yp-yi); bb=xk-xi-slope(yk-yi);
yj-yi=-2aa.bb(yp-yi)/(aa.aa+bb.bb);
xp-xi=.5(bb.bb-aa.aa)/bb.

subroutine zdraw(index i)	% starting point
		(index p)	% left turning point ($x↓p$ to be defined)
		(index k)	% middle point
		(index q)	% right turning point ($x↓q$ to be defined)
		(index j)	% ending point
		(var penht)	% effective height of hpen used
		(var penwd)	% effective pen width at point $k$
		(var slope):	% reciprocal of slope at point $k$
% This subroutine is dual to \\{sdraw}.
new w48,w49; w48=penwd; w49=penht;
cpen; lft0x5=lft48xk; rt0x6=rt48xk; y5=y6=yk;
if yp>yi: bot49yp=bot6y1; top49yp=top6y2;
	bot49yq=bot6y9; top49yq=top6y10;  
else: top49yp=top6y1; bot49yp=bot6y2;
	top49yq=top6y9; bot49yq=bot6y10;
fi;
x2=xp; x9=xq;
call zcomp(i,1,3,5,slope);	% compute $x↓1$ and point 3
call zcomp(i,2,4,6,slope);	% compute $x↓2$ and point 4
if (xi-x1)/(yi-y1)/(yi-y1)>(xi-x2)/(yi-y2)/(yi-y2):
	new x1,y1,aa,x3,y3;	% correction to keep ellipses from crossing
	2(xi-x2)/(yi-y2)/(yi-y2)=(xi-x5)aa-slope.slope/(xi-x5);
	if yp<yi: yi-y1=1/sqrt aa;
	else: yi-y1=-1/sqrt aa;
	fi;
	call zcomp(i,1,3,5,slope);	% recompute $x↓1$ and point 3
fi;
call zcomp(j,9,7,5,slope);	% compute $x↓9$ and point 7
call zcomp(j,10,8,6,slope);	% compute $x↓{10}$ and point 8
if (xj-x10)/(yj-y10)/(yj-y10)<(xj-x9)/(yj-y9)/(yj-y9):
	new x10,y10,aa,x8,y8;	% correction to keep ellipses from crossing
	2(xj-x9)/(yj-y9)/(yj-y9)=(xj-x6)aa-slope.slope/(xj-x6);
	if yq<yj: yj-y10=1/sqrt aa;
	else: yj-y10=-1/sqrt aa;
	fi;
	call zcomp(j,10,8,6,slope);	% recompute $x↓{10}$ and point 8
fi;
hpen; w0 ddraw i{0,y1-yi}..1{x1-xi,0}..3{slope(yq-yp),yq-yp}..
		7{slope(yq-yp),yq-yp}..
		9{xj-x9,0}..j{0,yj-y9},
	i{0,y2-yi}..2{x2-xi,0}..4{slope(yq-yp),yq-yp}..
		8{slope(yq-yp),yq-yp}..
		10{xj-x10,0}..j{0,yj-y10}.	% the s-curve

subroutine bar(index i, index j, index p, index q):
% This subroutine is similar to ``\&{vpen};\quad $w↓p$ \&{draw} $i\to j$'',
% but the \&{vpen} slants with italic.
no proofmode;	% the points computed aren't interesting
cpen; top q y1=top p yi; bot q y2=bot p yi;
top q y3=top p yj; bot q y4=bot p yj;
lft q x1=lft q x2=lft0xi; rt q x3=rt q x4=rt0xj;
w q  ddraw 1..3, 2..4.

subroutine lterm(index i) % point where the terminal is to be centered
		(index k): % height of the terminal
no proofmode;
cpen; x1=x2=xi; bot6y1=bot k yi; top6y2=top k yi;
lpen#; w6 draw 1..2;	% erase excess at left
vpenwd w6;	% next edition of MF will allow you to specify any rect ellipse
vpen; wk draw i;	% terminal
vpenwd w0.

subroutine rterm(index i) % point where the terminal is to be centered
		(index k): % height of the terminal
no proofmode;
cpen; x1=x2=xi; bot6y1=bot k yi; top6y2=top k yi;
rpen#; w6 draw 1..2;	% erase excess at right
vpenwd w6;	% next edition of MF will allow you to specify any rect ellipse
vpen; wk draw i;	% terminal
vpenwd w0.

subroutine fstroke(index i)	% dot position or bottom of terminal
		  (index j)	% $x$-coordinate of stem
		  (index k)	% width of lower stem
		  (index l)	% $y$-coordinate of top of terminal
		  (var sl):	% length of right serif
new w74; w74=round(wk-scorr);
hpen; bot1yj=0; lft74x0=lft k xj; x10=xj; y10=y0; top k y10=m;
%y1=.5[m,h]; x1=x0; x2=.5[x1,x3];
top6y1=.5[m,h]; x1=x0; x2=.5[x1,x3];
wk draw j..10; w74 draw 0..1;	% stem
lft74x1=lft20x14; rt74x1=rt20x11; y11=y14=y1;
if lcs=0: cpen; x3=xi;
%	top6y2=h+oo; call `a arc(0,2,6,0,1,74);	% shoulder
	x26=x11; y26=.5[m,h]; w20 ddraw 14..11, 14..26;	% link
	x21=x22=x2; top20y21=h+oo; y22=y21-(w6-w20);
	x24=1/sqrttwo[x22,x26]; x23=1/sqrttwo[x21,x14];
	y24=1/sqrttwo[y26,y22]; y23=1/sqrttwo[y14,y21];
	w20 ddraw 26{0,1}..24{x22-x26,y22-y26}..22{1,0},
		14{0,1}..23{x21-x14,y21-y14}..21{1,0};	% shoulder
%	xl=good20(xi-(1.5u/h)(yl-yi));
	xl=xi;
	w20 ddraw l{x21-xl,2(y21-yl)}..21{-1,0},
		i{x22-xi,3(y22-yi)}..22{-1,0};	% terminal
else: cpen; rt20x3=rt3xi; y3=y13=yi; x13=x3-(w0-w20);
	w3 draw i;	% bulb
	top20y12=h+oo; y2=y12-(w6-w20);
	new aa; y2=aa[y11,y12]; x2=aa[x11,x12];
	w20 ddraw 14{0,1}..12{1,0}..3{0,-1},
		11{0,1}..2{1,0}..13{0,-1};	% shoulder
	new aa;
	if w1+2lcs.u>4.5u-1: w1+2(lcs-aa).u=4.5u-1;
		if r<7u: new aa; aa=0;	% this correction not needed for simple f
		fi;
	else: aa=0;
	fi;
	call `a serif(j,k,1,1/3,-lcs+aa);
	call `b serif(j,k,1,1/3,sl-aa);
	call `c bserif(j,k,-lcs+aa,sl-aa);	% serif
fi.

subroutine hstroke(index i)	% $x$-coordinate of left stem
		(index j)	% $x$-coordinate of right stem
		(index k):	% will be set to base of right stem
hpen; xk=xj; bot1yk=0;
rt20x1=rt1xi; y1=1/8[e,m]; yj=1/3[e,m];
x9=x0=xi; y9=y1; bot1y0=0; w1 draw 0..9;	% thicken the bottom stem
cpen;
y4=y6=yj; lft20x4=lft1xj; rt20x6=rt1xj;
%x5=x6-2.15u; top20y5=m+oo;
x5=.5[rt20x1,rt20x6]; top20y5=m+oo;
y5-y3=w6-w20;
new alpha; y3=alpha[y1,y5]; x3=alpha[x1,x5];
new stwo; stwo = sqrt 1.23114413sqrttwo;	% the constant is $2↑{3/10}$
x7=theta[1/sqrttwo[x3,x4],x8]; y7=theta[1/sqrttwo[y4,y3],y8];
x8=1/stwo[x5,x6]; y8=1/stwo[y6,y5];
w20 ddraw 1{0,1}..5{1,0}..8{x6-x5,y6-y5}..6{0,-1},
	1{0,1}..3{1,0}..7{x4-x3,y4-y3}..4{0,-1};	% shoulder
hpen; w1 draw j..k.	% stem

subroutine bserif(index i)	% point where bowed serif appears
		(index k)	% w-variable for stem line
		(var lsl)	% left serif length
		(var rsl):	% right serif length
if bow≠0: hpen; top0y1=bot0yi-1; y2=y1+bow; y3=y1; x2=xi;
	lft0x1=lft k xi+lsl.u;
	rt0x3=rt k xi+rsl.u;
	cpen#; w6 draw 1{x2-x1,3(y2-y1)}..2{1,0}..
		3{x3-x2,3(y3-y2)}; % erase bowed part
fi.

subroutine ubserif(index i)	% point where upper bowed serif appears
		(index k)	% w-variable for stem line
		(var lsl)	% left serif length
		(var rsl):	% right serif length
if bow≠0: hpen; bot0y1=top0yi+1; y2=y1-bow; y3=y1; x2=xi;
	lft0x1=lft k xi+lsl.u;
	rt0x3=rt k xi+rsl.u;
	cpen#; w6 draw 1{x2-x1,3(y2-y1)}..2{1,0}..
		3{x3-x2,3(y3-y2)}; % erase bowed part
fi.

subroutine cdraw(index i, index j)	% given points
		(index p, index q):	% given widths, $w↓p≥w↓q$
% An implementation of the forbidden ``\&{cpen};\quad\&{draw} $|w↓p|i\to |w↓q|j$''.
% I should change the calling sequence to cdraw(i,p,j,q), or change other calls...
cpen; wp draw i;	% plot the bigger dot
new aa; (aa+eps)sqrt((xj-xi)(xj-xi)+(yj-yi)(yj-yi))=wp-wq;
x2-x1=aa(yi-yj); y2-y1=aa(xj-xi);
xi=.5[x1,x2]; yi=.5[y1,y2];	% perpendicular points
wq ddraw 1..j, 2..j.	% fill in the rest

subroutine qcirc(index i)	% horizontal endpoint
	(index j)	% intermediate point
	(index k)	% vertical endpoint
	(var size):	% size of \&{cpen} that draws a quarter circle
cpen; xj=1/sqrttwo[xi,xk]; yj=1/sqrttwo[yk,yi];
size draw i{xk-xi,0}..j{xk-xi,yk-yi}..k{0,yk-yi}.

subroutine hcirc(index viii, index i, index ii, index iii, index iv, var size):
xiv=xviii; yii=.5[yiv,yviii];
call qcirc(viii,i,ii,size); call qcirc(iv,iii,ii,size).

subroutine circle(index i, index ii, index iii, index iv,
	index v, index vi, index vii, index viii, var size):
xiv=xviii=.5[xvi,xii]; yii=yvi=.5[yiv,yviii];
call qcirc(viii,i,ii,size); call qcirc(iv,iii,ii,size);
call qcirc(iv,v,vi,size); call qcirc(viii,vii,vi,size).

subroutine entry(var z)		% $x$-coordinate for upward stroke
	(index j):	% $x$-coordinate for downward stroke ($y↓j$ will be set)
% This subroutine draws a little hook at the beginning left of an italic character,
% ending with the pen traveline vertically at point $j$ with size $w↓1$.
hpen; x1=good0z; y1=2/3m; yj=3/4m; x2=xj-1.5u; top0y2=m+oo;
draw |w0|1{(xj-2.5u)-x1,m}..|w0#|2{1,0}..|w1#|j{0,-1}.

subroutine skewentry(var z)	% $x$-coordinate for upward stroke
	(index j):	% $x$-coordinate for downward stroke ($y↓j$ will be set)
% This subroutine is analogous to \\{entry}, but the pen starts out vertical
% and ends at the skewed slope $\{-u,-m\}$ to compensate for optical illusion.
hpen; x1=good0z; y1=2/3m; yj=3/4m;
x2=xj-1.25u; top0y2=m+oo;
draw |w0|1{0,1}..|w0#|2{1,0}..|w1#|j{-u,-m}.

subroutine exit(index i)	% $x$-coordinate for downward stroke ($y↓i$ will be set)
	(var z):	% $x$-coordinate for upward stroke
% This subroutine draws a little hook at the ending right of an italic character,
% beginning with the pen traveling vertically at point $i$ with size $w↓1$.
hpen; x2=good0z; y2=1/3m; yi=1/4m; x1=xi+1.5u; bot0y1=-oo;
draw |w1#|i{0,-1}..|w0#|1{1,0}..2{x2-(xi+2.5u),m}.

subroutine skewexit(index i)	% $x$-coordinate for downward stroke ($y↓i$ will be set)
	(var z):	% $x$-coordinate for upward stroke
% This subroutine is analogous to \\{exit}, but the pen begins with the skewed
% slope $\{-u,-m\}$ to compensate for optical illusion, and ends vertically.
hpen; x2=good0z; y2=1/3m; yi=1/4m; x1=xi+1.25u; bot0y1=-oo;
draw |w1#|i{-u,-m}..|w0#|1{1,0}..2{0,1}.

subroutine italhstroke(index i)	% starting point
		(index j):	% $x$-coordinate of right stem ($y↓j$ will be set)
hpen; x1=.6[xi,xj]; x2=xj-.4u; top0y1=m+oo; y2=.75[e,y1];
yj=.3[e,m];
draw |w0|i{0,1}..|w0#|1{1,0}..|.75[w0,w1]|2..|w1#|j{0,-1}.

subroutine pistroke:	% makes the bar of pi, tau, variant omega
vpen; x1=good0(0); y1=m-m/3.14159;
x2=2u; top7y2=m; y3=y2; x3=r-1.5u;
draw |w6#|1{x2-x1,3.14159(y2-y1)}..|w7#|2{1,0}..3;	% bar
cpen; w7 draw 3.	% make the end point round

subroutine endv(index i):	% draws final bulb starting at this point
cpen; x1=xi-u; x2=xi-6u; top2y1=m+oo; y2=y1;
hpen; draw |w0#|i{0,1}..|w2#|1(..2);	% stroke
cpen; w2 draw 1.	% bulb

subroutine max(var a, var b):	% sets $\\{acc}=\max(a,b)$
new acc;
if a>b: acc=a;
else: acc=b;
fi.
% From file AMR10.MF[MF,SYS]

call fontbegin;
% input roman;
% From file ROMAN[MF,SYS]

% The Computer Modern Roman family of fonts (by D. E. Knuth, 1979--1981)
danger=mi=dc=italic=0;
if ligs≠0: spanx='074; spanq='076; 
else: spanx='016; spanq='017;
fi;
% input romanu;	% upper case (majuscules)

% From file ROMANU[MF,SYS]

% Computer Modern Roman upper case:
% These letters were originally coded by D. E. Knuth in November, 1979,
% inspired by the Monotype alphabets used in {\sl The Art of Computer Programming}.
% For text spacing, set $\\{mi}=0$; for math spacing, set $\\{mi}=1$.
% Character codes $\\{dc}+\¬101$ through $\\{dc}+\¬132$ are generated.
% Note that each character code is shifted by the amount \\{dc}.
% For example, when making `caps and small caps' fonts, set $\\{dc}=\¬40$,
% to get the upper case letters moved into lower case positions.

new mc,lbowl,rbowl,rstem,rv,hic;	% quantities used to compute spacing
mc=mi/pu;	% converts to relative units when $\\{mi}=1$
lbowl=.3phh.slant+.5pu;	% used at left of upper-case bowl
rbowl=.7phh.slant-.5pu;	% used at right of upper-case bowl
if pwiv>2pu: rstem=phh.slant+(ucs+usc-1.5)pu;	% used at right of tall stem
else: rstem=phh.slant+(ucs+usc-2.5)pu+.5pwiv;
fi;
rv=phh.slant+(ucs+.75usc-1)pu;	% used at right of tall diagonal
hic=1-.5mi;	% used when half the italic correction goes into \\{rtcorr}
% From file ROMANU[MF,SYS]

"The letter A";
call charbegin(dc+`A,13,usc,usc,phh,0,0);
hpen; new w98,w99;
if pw>.5pwiv: w98=round(w0-3scorr); lft98x1=round((usc+.8ucs+.5)u-.5);
else: w98=w0; lft98x1=round 1.75u;
fi;
w99=round .5[w4,w5];
bot98y1=0; rt99x4=r-lft98x1; bot99y4=0;
x3-x1=x4-x2; rt99x2=rt98x3+del;
if pw>.5pwiv: cpen; new w95,w96;
	w96=w26; w95=w25;
	bot96y11=bot95y21=0; top96y3=hh;
	y11=y31=y14=y34; y24=y21; y12=y2=y3=y13;
	lft98x1=lft95x21; rt98x1=rt96x11; lft99x4=lft96x14; rt99x4=rt95x24;
	lft98x3=lft96x13; rt99x2=rt96x12;
	x20=round(w98/(w98+w99)[lft98x3,rt99x2]-.5); y20=hh-w18-3hcorr;
	new aa; y1=aa[y31,y3];
	x1=aa[x31,x3]; x4=aa[x34,x2];
	call `g diag(21,13,31,3,95,96);	% left half of left diagonal
	call `h notch(31,11,96,3,20);	% right half of left diagonal
	call `i notch(34,14,96,2,20);	% left half of right diagonal
	call `j diag(24,12,34,2,95,96);	% right half of right diagonal
	if fixwidth[1,crisp]=0: x50=.5[x13,x12]; top96y50=round top6y13;
			w96 ddraw 13{x3-x1,y3-y21}..50{1,0}..12{x4-x2,y24-y2},
				13..3..12;	% round off middle
			fi;
	y5=y6; top18y5=round e;
	new aa,bb;	% auxiliary variables for intersection of lines
	x5=aa[x1,x3]; y5=aa[y1,y3];
	x6=bb[x4,x2]; y6=bb[y4,y2];
	w18 draw 5..6;	% bar line
else: top98y3=top99y2=hh+o+oo;
	w99 draw 2..4; w98 draw 2..3;	% right diagonal stroke
	y5=y6=e;
	new aa,bb;	% auxiliary variables for intersection of lines
	x5=aa[x1,x3]; y5=aa[y1,y3];
	x6=bb[x4,x2]; y6=bb[y4,y2];
	cpen; w18 draw 5..6;	% bar line
	lpen#; w99 draw 3..5;	% erase excess at upper left
	hpen; w98 draw 3..1;	% left diagonal stroke
fi;
if ucs≠0: new aa;
	if rt98x1+ucs.u+.5u>lft99x4-ucs.u-2: rt98x1+aa.u+.5u=lft99x4-aa.u-2;
	else: aa=ucs;
	fi;	% note: I should change all the similar routines to read like this!
	% note that "a+w1>x3-x2-1" is equiv to "a+rt1x2>lft1x3-2"
	call `a dserif(1,98,3,1/2,-.8ucs);
	call `b dserif(1,98,3,.6,aa);
	call `c bserif(1,98,-.8ucs,aa);	% left serif
	call `d serif(4,99,2,1/2,-aa);
	call `e serif(4,99,2,1/3,+.8ucs);
	call `f bserif(4,99,-aa,+.8ucs);	% right serif
fi.
% From file ROMANU[MF,SYS]

"The letter B";
call charbegin(dc+`B,12.5,usc,-.5mc(.75phh.slant-.5pu),phh,0,
	hic(.75phh.slant-.5pu));
new w80; w80=round(w4-2scorr);
new w85,delta;
if ucs=0: w85=round(w5-3scorr); delta=-.5u;
else: w85=w5; delta=0;
fi;
hpen; top80y1=hh; bot80y2=0;
if w80>2u: lft80x1=lft80x2=round 2u;
else: x1=x2=good80 3u;
fi;
w80 draw 1..2;	% stem
x3=x5=1/2[1.5u,r]+delta;  x13=x15=x18=x1; x6=x8=x3+1/2u;
vpen; top17y3=top6y1; y13=y3; bot17y18=bot6y2; y8=y18;
bot6y15=round .5hh; y5=y6=y15; x93=x3; y93=y13; x98=x8; y98=y18;
w17 draw 13..93;	% upper bar line
w17 draw 18..98;	% lower bar line
cpen; w6 draw 15..6;	% middle bar line
new w99; w99=round(.6w6+.5);
x25=x5; x26=x6; top99y25=top6y5; bot99y26=bot6y6;
rt85x4=round(r-1.5u); rt85x7=round(r-u); y4=.5[y3,y5]; y7=.5[y6,y8];
call `g arc(0,3,17,delta,4,85); call `h arc(0,25,99,delta,4,85);	% upper bowl
call `i arc(0,26,99,delta,7,85); call `j arc(0,8,17,delta,7,85);	% lower bowl
if ucs≠0:
	call `a serif(1,80,2,1/3,-ucs);
	call `b serif(1,80,2,1/3,.5ucs);
	call `c ubserif(1,80,-ucs,.5ucs);	% upper serif
	call `d serif(2,80,1,1/3,-ucs);
	call `e serif(2,80,1,1/3,.5ucs);
	call `f bserif(2,80,-ucs,.5ucs);	% lower serif
fi.
% From file ROMANU[MF,SYS]

"The letter C";
if ucs=0: call charbegin(dc+`C,11.5,mc.lbowl,-.5mc(phh.slant-.5pu),
					phh,0,hic(phh.slant-.5pu));
	cpen; x3=x5=round .5(r+2.5u); bot19y5=-o;
	new w99; w99=w19; top99y3=hh+o;
	rt20x2=round(r-1.25u);
	x31=x32=x3; top20y31=top99y3; bot20y32=bot99y3;
	top20y1=round .95hh+o; y2=round(y1-9/7[w6,w3]+w20);
	x1=x2;
	w20 ddraw 1{x31-x1,2(y31-y1)}..31{-1,0},
		2{x32-x2,2.5(y32-y2)}..32{-1,0};	% upper terminal
	if w5>2u: lft5x4=round u;
	else: x4=good5 2u;
	fi;
	y4=.5hh; call `a arc(0,3,99,0,4,5);	% upper part of stroke
	call `b arc(0,5,19,0,4,5);	% lower part of stroke
	new w93; w93=w3; %y30=good93 .125hh;
%	top20y7=top93y30; bot20y6=bot93y30;
	bot20y6=round .07hh-o; y7=y6+w93-w20;
	rt20x7=round(r-u);
	x6=good20(x7-(u/h)(y7-y6));
	bot20y16=bot19y5; top20y17=top19y5; x16=x17=x5;
	w20 ddraw 17{1,0}..7{x7-x17,2(y7-y17)},
		16{1,0}..6{x6-x16,3(y6-y16)};	% lower terminal
else: call charbegin(dc+`C,13,mc.lbowl,-.5mc(phh.slant-.5pu),
					phh,0,hic(phh.slant-.5pu));
	cpen; rt20x1=round(r-u); x5=x1; x11=x15=x1-(w16-w20);
	lft20x3=round u; x13=x3+w5-w20; x12=x14=.55[x13,x11];
	top20y2=hh+o; y12=y2-(w22-w20); bot20y4=-o;
	y14=y4+w22-w20; y3=y13=.5[y2,y4];
	if m<.6hh: bot6y1=round 2/3hh;
	else: y1=good6 m;
	fi;
	y11=y1; y5=y15=good6 .95(hh-y1);
	new aa; y2=aa[y12,y1]; x2=aa[x12,x1];
	new aa; y4=aa[y14,y5]; x4=aa[x14,x5];
	x7=x1; top20y7=hh; lft20x8=x11-w5; y8=y1;
	x6=x11; y6=.5[y1,y5];
	w20 ddraw 1..7, 8..7;	% upper serif
	lpen#; w5+1 draw (6..)11..12{-1,0};	% erase spurious part
	hpen; y88=y11; rt16x88=rt20x1; w16 draw 88;
	cpen;
	x0=1/sqrttwo[x2,x3]; x10=theta[1/sqrttwo[x12,x13],x0];
	x9=1/sqrttwo[x4,x3]; x19=theta[1/sqrttwo[x14,x13],x9];
	y0=1/sqrttwo[y3,y2]; y10=theta[1/sqrttwo[y13,y12],y0];
	y9=1/sqrttwo[y3,y4]; y19=theta[1/sqrttwo[y13,y14],y9];
	w20 ddraw (6..)1..2{-1,0}..0{x3-x2,y3-y2}..3{0,-1}..
			9{x4-x3,y4-y3}..4{1,0}..5(..6),
		(6..)11..12{-1,0}..10{x13-x12,y13-y12}..13{0,-1}..
			19{x14-x13,y14-y13}..14{1,0}..15{0,1}(..6);	% main stroke
		hpen; y89=y15; rt16x89=rt20x5; w16 draw 89;
fi.
% From file AMR10.MF[MF,SYS]